home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / WZSEND.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-26  |  17KB  |  506 lines
  1. UNIT WZSend;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ SendWaZOO Processor                           Last changed: 26.06.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                             Birger Kristensen                            ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos;
  16.  
  17. FUNCTION SendReqFiles(SendMode: Byte; Net, Node: Integer): Boolean;
  18. FUNCTION SendWaZOO(SendMode: Byte): Boolean;
  19.  
  20. IMPLEMENTATION
  21.  
  22. USES OpCrt, OpDate, OpDos, OpString, ApTimer,
  23.      Event, Com, MailUtil, Globals, ZMisc, ZSend, NodeList, BiMail,Util,
  24.      FileUtil, StrUtil, Protocol, Modem, ParseReq, PTpl, LogFile, PoPTypes;
  25.  
  26. VAR
  27.   tempsr         : SEARCHREC;
  28.  
  29.   FUNCTION SendMDM7(FName: S30): Boolean;
  30.   LABEL
  31.     Top, Fubar;
  32.   VAR
  33.     OrigFName,
  34.     Stat : S30;
  35.     i,XChkSum,
  36.     Tries : Byte;
  37.     Timer : EventTimer;
  38.     InByte : Integer;
  39.     ch:BYTE;
  40.   BEGIN
  41.     SendMDM7:=False;
  42.     OrigFName:=FName;
  43.     ComPort^.SetXOn(Off);
  44.     FName:=StUpCase(Pad(JustName(FName),8)+Pad(JustExtension(FName),3))+#0;
  45.     Tries:=0;
  46.     XChkSum:=SUB;
  47.     FOR i:=1 TO 11 DO
  48.       Inc(XChkSum, Byte(FName[i]));
  49.     NewTimerSecs(Timer, 60);
  50. Top:
  51.     i:=1;
  52.     Inc(Tries);
  53.     Stat:='Que WHAT??';
  54.     WHILE ComPort^.Carrier AND (Tries<8) AND NOT (TimerExpired(Timer)) DO
  55.     BEGIN
  56.       InByte:=TimedRead(6000); { 100 }
  57.       CASE InByte OF
  58.         NAK : BEGIN
  59.                 ComPort^.WriteByte(Ack, False);
  60.                 ComPort^.WriteByte(Byte(FName[1]), True);
  61.                 Inc(i);
  62.                 IF ComPort^.KeyPressed THEN
  63.                 BEGIN
  64.                   ComPort^.Peek(ch);
  65.                   IF ch=NAK THEN ch:=ComPort^.ReadByte;
  66.                 END;
  67.               END;
  68.         ACK : IF i=12 THEN
  69.               BEGIN
  70.                 ComPort^.WriteByte(SUB, True); { Rettet false til True 20/4-95}
  71.                 InByte:=TimedRead(100);
  72.                 IF InByte=XChkSum THEN
  73.                 BEGIN
  74.                   ComPort^.WriteByte(ACK, True);
  75. {                  AddLog('!', 'Modem 7 filename færdig'); }
  76.                   SendMDM7:=True;
  77.                   Exit;
  78.                 END ELSE
  79.                 BEGIN
  80.                   AddLog('!', 'Checksum error on Modem 7 filename');
  81.                   ComPort^.WriteByte(Byte('u'), True);
  82.                   GOTO Top;
  83.                 END;
  84.               END ELSE
  85.               BEGIN
  86.                 ComPort^.WriteByte(Byte(FName[i]), True);
  87.                 Inc(i);
  88.               END;
  89. {
  90.         Byte('C') : BEGIN
  91.                       AddLog('!','File: '+OrigFName+' skipped by remote');
  92.                       Exit;
  93.                     END;
  94. }
  95.         ELSE  BEGIN
  96.                 ComPort^.WriteByte(Byte('u'), True);
  97.                 GOTO Top;
  98.               END;
  99.       END;
  100.     END;
  101. Fubar:
  102.     IF Tries>=7 THEN Stat:='FUBAR....';
  103.     AddLog('!', Stat);
  104.   END;
  105.  
  106.   FUNCTION SendReqFiles(SendMode: Byte; Net, Node: Integer): Boolean;
  107.   VAR
  108.     FreeArea  : TFreeArea;
  109.     s         : String;
  110.     TransTime : Time;
  111.     GotIt     : Boolean;
  112.   BEGIN
  113.     IF (ComPort^.GetBaudRate>=Cfg.Request.MinBaud) AND InitReqFile(Net,Node) THEN
  114.     BEGIN
  115.       SendReqFiles:=True;
  116.       tempsr.attr:=0;
  117.       tempsr.size:=0;
  118.       addtpl(rspfile,'HEADER', tempsr);
  119.       IF (Cfg.Request.Limit[nsUnknown,rlPrCall].MaxFiles=0) AND (GlobNodeStat=nsUnknown) THEN
  120.         AddTpl(rspfile,'UNKNOWN', tempsr);
  121.       IF Cfg.Request.Limit[GlobNodeStat,rlPrCall].MaxFiles>0 THEN
  122.       BEGIN
  123.         REPEAT
  124.           s:=GetNextFileToSend(FreeArea);
  125.           IF s<>'' THEN
  126.           BEGIN
  127.             IF (MaxReqFiles>0) OR (FreeArea=faTotally) THEN
  128.             BEGIN
  129.               IF (MaxReqBytes-ReqSr.Size>=0) OR (FreeArea=faTotally) THEN
  130.               BEGIN
  131.                 TransTime:=ReqSr.Size DIV (ComPort^.GetBaudRate DIV 10);
  132.                 IF (TimeToNoMoreRequest>TransTime) AND
  133.                    ((MaxReqTime>TransTime) OR (FreeArea=faTotally)) THEN
  134.                 BEGIN
  135.                   GotIt:=True;
  136.                   CASE SendMode OF
  137.                     0: AddToTransferList(s, False);
  138.                     1: BEGIN
  139.                          GotIt:=ZModemSend(s, '', fsent, 8192)=ZTrue;
  140.                          Inc(FSent);
  141.                        END;
  142.                     2: ;
  143.                   END;
  144.                   Dec(TimeToNoMoreRequest, TransTime);
  145.                   IF (FreeArea=faNoWay) AND GotIt THEN
  146.                   BEGIN
  147.                     Dec(MaxReqFiles); Dec(MaxReqBytes,ReqSr.Size);
  148.                     Dec(MaxReqTime,TransTime);
  149.                     WITH DRI DO
  150.                     BEGIN
  151.                       Inc(NumFiles); Inc(NumBytes, ReqSr.Size);
  152.                       Inc(UsedTime, TransTime);
  153.                     END;
  154.                   END;
  155.                   Inc(tempsr.attr);
  156.                   Inc(tempsr.size, reqsr.size);
  157.                   AddTpl(rspfile,'FOUND', reqsr);
  158.                 END ELSE
  159.                 BEGIN
  160.                   AddTpl(rspfile, 'TIMEOUT', reqsr);
  161.                   AddLog('#','Not enough time (Lft: '+
  162.                              TimeToTimeString('Hh:mm:ss',Min(MaxReqTime,TimeToNoMoreRequest))+
  163.                              '/Tfr: '+
  164.                              TimeToTimeString('Hh:mm:ss',TransTime)+'): '+s);
  165.                 END;
  166.               END ELSE
  167.               BEGIN
  168.                 AddTpl(RspFile,'TOOBIG',ReqSr);
  169.                 AddLog('#','File too big ('+Long2Str(MaxReqBytes)+'): '+s);
  170.               END;
  171.             END ELSE
  172.             BEGIN
  173.               AddTpl(RspFile,'TOOMANY',reqsr);
  174.               AddLog('#','Too many files '+s);
  175.             END ;
  176.           END;
  177.         UNTIL s='';
  178.       END;
  179.     END ELSE
  180.       SendReqFiles:=False;
  181.   END;
  182.  
  183.   PROCEDURE RespondToFileRequest(SendMode: Byte);
  184.   VAR
  185.     MustDoFoot     : Boolean;
  186.     SendName       : String;
  187.     Net, Node, i   : Integer;
  188.   BEGIN
  189.     StartTime:=CurrentTime;
  190.     IF (CurrentEvent.Typ AND etRequests<>0) AND NOT NodesRec.DisallowReq AND ReqOk THEN
  191.     BEGIN
  192.       MustDoFoot:=False;
  193.       FOR i:=1 TO MaxAddresses DO
  194.       BEGIN
  195.         Net:=Cfg.Addresses[i].Net;
  196.         Node:=Cfg.Addresses[i].Node;
  197.         IF SendReqFiles(SendMode,Net,Node) THEN MustDoFoot:=True;
  198.       END;
  199.       IF MustDoFoot THEN
  200.       BEGIN
  201.         WriteSuckerInfo(DRI);
  202.         AddTpl(RspFile, 'FOOT', TempSr);
  203.       END;
  204.       IF ExistFile(RspFile) THEN
  205.       BEGIN
  206.         IF Cfg.Request.RspAsPkt THEN SendName:=InventPktName ELSE SendName:='';
  207.         CASE SendMode OF
  208.           0: AddToTransferList(rspfile, Cfg.Request.RspAsPkt);
  209.           1: BEGIN
  210.                ZModemSend(rspfile, SendName, fsent, 8192);
  211.                Inc(FSent);
  212.                DeleteFile(RspFile);
  213.              END;
  214.           2: ;
  215.         END;
  216.       END;
  217.     END;
  218.   END;
  219.  
  220.   FUNCTION DoFLOfile(CONST ExtFlags: S5; SendMode: Byte): Boolean;
  221.   LABEL
  222.     next;
  223.   VAR
  224.     SkippedOne : Boolean;
  225.     Res,
  226.     Io, ZRes   : Integer;
  227.     FName,
  228.     HoldName   : PathStr;
  229.     c, Tries   : Byte;
  230.     fp         : FILE;
  231.     s, SPtr    : STRING;
  232.     Current,
  233.     LastStart  : LongInt;
  234.     i, ch      : Char;
  235.     Srec       : SearchRec;
  236.   BEGIN
  237.     DoFLOfile:=False;
  238.     HoldName:=HoldAreaPath(Call,False);
  239.     IF ChkDir(HoldName) THEN
  240.     BEGIN
  241.       FOR c:=1 TO 5 DO
  242.       BEGIN
  243.         SkippedOne:=False;
  244.         FName:=HoldFileName(Call,False)+ExtFlags[c]+'LO';
  245.         Assign(fp, FName); FileMode:=ShareRW+ShareDenyW;
  246.         Tries:=0;
  247.         REPEAT
  248.           Reset(fp,1);
  249.           Io:=IOResult;
  250.           IF Io=5 THEN
  251.           BEGIN
  252.             Pause(50);
  253.             Inc(Tries);
  254.           END;
  255.         UNTIL (Io<>5) Or (Tries=10);
  256.         IF Io=0 THEN
  257.         BEGIN
  258.           Current:=0;
  259.           WHILE NOT EoF(fp) DO
  260.           BEGIN
  261.             LastStart:=Current;
  262.             ReadLine(fp,s);
  263.             SPtr:=s;
  264.             Current:=FilePos(fp);
  265.             IF SPtr[1]=TruncAfter THEN
  266.             BEGIN
  267.               SPtr:=Copy(SPtr, 2, Length(SPtr) - 1);
  268.               i:=TruncAfter;
  269.             END ELSE
  270.               IF SPtr[1]=ShowDeleteAfter THEN
  271.               BEGIN
  272.                 SPtr:=Copy(SPtr, 2, Length(SPtr) - 1);
  273.                 i:=ShowDeleteAfter;
  274.               END ELSE
  275.                 i:=NothingAfter;
  276.             IF Length(SPtr)=0 THEN GOTO next;
  277.             IF SPtr[1] <> '~' THEN
  278.             BEGIN
  279.               IF NOT isCaller AND ((CurrentEvent.Typ AND etNoFiles)<>0) AND
  280.                  (StUpCase(Copy(SPtr, 1, Length(Cfg.Outbound)))<>StUpCase(Cfg.Outbound)) THEN
  281.               BEGIN
  282.                 SkippedOne:=True;
  283.                 GOTO Next;
  284.               END;
  285.               FindFirst(SPtr, AnyFile, Srec);
  286.               IF DOSError <> 0 THEN
  287.               BEGIN
  288.                 AddLog('!', 'File not found ' + SPtr);
  289.                 FindClose(SRec);
  290.                 GOTO Next;
  291.               END;
  292.               FindClose(SRec);
  293.               IF Srec.size=0 THEN GOTO Next;
  294.               CASE SendMode OF
  295.                 0: AddToTransferList(SPtr,FALSE);
  296.                 1: BEGIN
  297.                      ZRes:=ZModemSend(SPtr, '', fsent, 8192);
  298.                      IF (ZRes<>ZTRUE) And (ZRes<>SPEC_COND) THEN
  299.                      BEGIN
  300.                        Close(fp);
  301.                        NetProblems:=1;
  302.                        Exit;
  303.                      END;
  304.                    END;
  305.                 2: BEGIN
  306.                      IF SendMDM7(JustFileName(Sptr)) THEN
  307.                      BEGIN
  308.                        Res:=SendFile(SPtr,'',TeLink);
  309.                        IF Res<>1 THEN
  310.                        BEGIN
  311.                          Close(fp);
  312.                          AddLog('!', 'Error sending: '+SPtr);
  313.                          Exit;
  314.                        END;
  315.                      END ELSE
  316.                        SkippedOne:=True;
  317.                    END;
  318.                 END;
  319.                 Inc(fsent);
  320.                 IF SendMode<>0 THEN
  321.                 BEGIN
  322.                   IF ((SendMode=1) AND (ZRes<>SPEC_COND)) OR
  323.                      (SendMode=2) THEN
  324.                   BEGIN
  325.                     Seek(fp, LastStart);
  326.                     Ch:=#126;
  327.                     BlockWrite(fp, Ch, 1);
  328.                     Seek(fp, Current);
  329.                     IF i=TruncAfter THEN
  330.                     BEGIN
  331.                       TruncateFile(SPtr);
  332.                       AddLog('#', 'Flagging ' + SPtr + ' as sent');
  333.                     END ELSE
  334.                       IF i=ShowDeleteAfter THEN
  335.                       BEGIN
  336.                         IF DeleteFile(SPtr) THEN AddLog('#', 'Unlinking ' + SPtr);
  337.                       END ELSE
  338.                         IF i=DeleteAfter THEN DeleteFile(SPtr);
  339.                   END;
  340.                   IF (SendMode=1) AND (ZRes=SPEC_COND) THEN SkippedOne:=True;
  341.                 END;
  342.               END;
  343. Next:
  344.           END;   { While }
  345.           Close(fp);
  346.           IF (SendMode<>0) AND NOT SkippedOne THEN DeleteFile(FName);
  347.         END ELSE   { Not found }
  348.           IF Io=5 THEN AddLog('!','Mail locked by other task');
  349.       END;   { For }
  350.     END;
  351.     DoFLOfile:=True;
  352.   END;
  353.  
  354.   FUNCTION SendWaZOO(SendMode: Byte): Boolean;
  355.   VAR
  356.     SentReqName:S12;
  357.     c,AkaNum       : Byte;
  358.     FName, HoldName : PathStr;
  359.     NoMoreAkas,OutFileSent:Boolean;
  360.     LocFSent : Word;
  361.     GemAdr : TFidoAddress;
  362.     BusyFile : File;
  363.  
  364.     FUNCTION SendOutFile: Boolean;
  365.     VAR
  366.       i:WORD;
  367.       ph : TPktHeader;
  368.       f : File;
  369.       s,ss : String;
  370.     BEGIN
  371.       FillOutPktHeader(cfg.Addresses[Cfg.MainAdrNum],Call,ph);
  372.       FILLCHAR(ph.PassWord,SizeOf(Ph.PassWord),0);
  373.       Str2AsciiZ(NodesRec.SessionPwd,ph.PassWord,7);
  374.       s:=HoldFileName(Call,True)+'OUT';
  375.       Assign(f,s);
  376.       ReWrite(f,1);
  377.       BlockWrite(f,ph,SizeOf(ph));
  378.       i:=0;
  379.       BlockWrite(f,i,2);
  380.       CLOSE(f);
  381.       ss:=InventPktName;
  382.       i := SendFile(s, ss, TeLink);
  383.       DeleteFile(s);
  384.       SendOutFile:=(i<2);
  385.     END;
  386.  
  387.   BEGIN
  388.     SendWaZOO:=False;
  389.     fsent:=0; LocFSent:=0;
  390.     OutFileSent:=FALSE;
  391.     GemAdr:=Call;
  392.     AkaNum:=0; NoMoreAkas:=False;
  393.     REPEAT
  394.       IF IsCaller THEN ExtFlags[1]:=' ' ELSE ExtFlags[1]:='H';
  395.       ExtFlags[3]:='O';
  396.       IF MarkNodeBusy(BusyFile,Call) THEN
  397.       BEGIN
  398.         HoldName:=HoldAreaPath(Call,False);
  399.         IF ChkDir(HoldName) THEN
  400.         BEGIN
  401.           FOR c:=1 TO 5 DO
  402.           BEGIN
  403.             FName:=HoldFileName(Call,False)+ExtFlags[c]+'UT';
  404.             IF ExistFile(FName) THEN
  405.             BEGIN
  406.               OutFileSent:=TRUE;
  407.               CASE SendMode OF
  408.                 0: AddToTransferList(FName,TRUE);
  409.                 1: IF ZModemSend(FName, InventPktName, fsent, 8192) <> ZTRUE THEN
  410.                    BEGIN
  411.                       NetProblems:=1;
  412.                       UnMarkNodeBusy(BusyFile);
  413.                       Exit;
  414.                     END;
  415.                 2: IF SendFile(FName, InventPktName, TeLink)<>1 THEN {rettet 0 til 1 BK}
  416.                    BEGIN
  417.                      NetProblems:=1;
  418.                      UnMarkNodeBusy(BusyFile);
  419.                      Exit;
  420.                    END;
  421.               END;
  422.               Inc(fsent);
  423.               IF SendMode<>0 THEN
  424.                 IF NOT DeleteFile(FName) THEN WriteLn('Error deleting ', FName);
  425.             END;
  426.           END;
  427.           IF (SendMode=2) AND NOT OutFileSent AND NOT SendOutFile THEN
  428.           BEGIN
  429.             UnMarkNodeBusy(BusyFile);
  430.             AddLog('!', 'Error sending dummy pkt file');
  431.             Exit;
  432.           END;
  433.           ExtFlags[3]:='F';
  434.           IF NOT DoFLOfile(ExtFlags, SendMode) THEN
  435.           BEGIN
  436.             UnMarkNodeBusy(BusyFile);
  437.             Exit;
  438.           END;
  439.         END;
  440.         IF SendMode=1 THEN
  441.         BEGIN
  442.           RequestSent:=False;
  443.           FName:=HoldFileName(Call,False)+'REQ';
  444.           IF ExistFile(FName) THEN
  445.           BEGIN
  446.             IF WzFreq IN RemHello.Capabilities THEN
  447.             BEGIN
  448.               RequestSent:=True;
  449.               AddLog(':', 'Making file request');
  450.               IF Call.Point<>0 THEN SentReqName:=HexW(Call.Net)+HexW(Call.Node)+'.REQ' ELSE SentReqName:='';
  451.               IF ZModemSend(FName, SentReqName, fsent, 8192)=ZTRUE THEN
  452.               BEGIN
  453.                 IF NOT DeleteFile(FName) THEN AddLog('!','Error deleting '+FName);
  454.               END;
  455.               Inc(fsent);
  456.             END ELSE
  457.               AddLog(':','File request declined');
  458.           END;
  459.           { Respond to file request }
  460.         END;
  461.         UnMarkNodeBusy(BusyFile);
  462.       END ELSE
  463.         AddLog(':',Address2Str(Call)+' is marked busy - skipping');
  464.       Inc(AkaNum);
  465.       IF (AkaNum<=MaxAddresses) And (RemAka[AkaNum].Zone<>0) THEN
  466.       BEGIN
  467.         Inc(LocFSent, FSent); FSent:=0;
  468.         Call:=RemAka[AkaNum];
  469.         AddLog(':','Sending to AKA: '+Address2Str(Call));
  470.       END ELSE
  471.       BEGIN
  472.         NoMoreAkas:=True;
  473.         IF AkaNum>1 THEN
  474.         BEGIN
  475.           FSent:=LocFSent+FSent;
  476.         END;
  477.       END;
  478.     UNTIL NoMoreAkas;
  479.     Call:=GemAdr;
  480.     IF SendMode<>2 THEN RespondToFileRequest(SendMode);
  481.     IF SendMode<>0 THEN
  482.     BEGIN
  483.       IF fsent=0 THEN
  484.       BEGIN
  485.         IF AkaNum=1 THEN AddLog('!', 'Nothing to send to: '+Address2Str(Call));
  486.         CASE SendMode OF
  487.           1: IF ZModemSend('', '', -2, 8192) <> ZTRUE THEN
  488.              BEGIN
  489.                NetProblems:=1;
  490.                Exit;
  491.              END;
  492.           2: IF SendMDM7('') THEN
  493.                IF SendFile('','',TeLink)<>0 THEN
  494.                BEGIN
  495.                  NetProblems:=1;
  496.                  Exit;
  497.                END;
  498.         END;
  499.       END ELSE
  500.         IF SendMode=1 THEN ZModemSend('', '',-1, 8192);
  501.     END;
  502.     SendWaZOO:=True;
  503.   END;
  504.  
  505. END.
  506.